home *** CD-ROM | disk | FTP | other *** search
/ Hottest 6 / Hottest 6 (1996)(PDSoft)[!].iso / software / programming / pascal / unit2 / test.pas < prev    next >
Pascal/Delphi Source File  |  1978-11-24  |  3KB  |  83 lines
  1. { *    This is a test program set up to use the unit "Base".
  2.     
  3.     The whole concept behind this is to make units that "take care of
  4.     themselves"... you use them, and as soon as your program is finished,
  5.     either through a normal termination or a Halt(..), they clean up
  6.     after themselves.
  7.     
  8.     I'm just starting the process of making a bunch of these to make my
  9.     life easier.  Look for something that uses GadTools sometime soonish.
  10.     
  11.     Just to note: rather small, isn't it? No need to OpenLibrary yourself
  12.     or anything complex.  YES, I got sick of copying my window and screen
  13.     routines around <grin> --- hopefully someone can benefit from my
  14.     laziness ;-)
  15.     
  16.     Written in HighSpeed Pascal 1.10 by Ritchie Annand
  17. }
  18.     
  19. program Test;
  20.  
  21. uses Exec,Graphics,Intuition,Base,Gadgets;
  22.                             { ^ Base and Gadgets are our custom units }
  23. var
  24.     scr : pScreen;    { Pointer to a screen type }
  25.     bwin: pWindow;    { A couple of window pointers }
  26.     win : pWindow;
  27.     msg : pIntuiMessage;    { Pointer to a message type, of course }
  28.     done: boolean;
  29.     menuno    : word;    { Menu number selected }
  30.     itemno    : word;    { Item number selected }
  31.     subno    : word;    { Subitem number selected }
  32. begin
  33.     {--- Use NewScreen routine to open a screen that will be automatically
  34.         taken care of ---}
  35.     scr := NewScreen(640,400,2,HIRES or LACE,'',TRUE);
  36.     {--- Use NewWindow routine to open a borderless window, the size of the
  37.         whole screen, that will be automatically taken care of ---}
  38.     bwin := NewWindow(0,0,640,400,
  39.                     0,BORDERLESS,
  40.                     0,0,0,0,'',scr);
  41.     {--- Use NewWindow to open up a little "Hello" window ---}
  42.     win := NewWindow(0,0,320,200,
  43.                     CLOSEWINDOW_ or MENUPICK,
  44.                     WINDOWCLOSE or WINDOWDRAG,
  45.                     200,100,640,400,'Hello',scr);
  46.     AddTitle('My menu');
  47.     AddChoice('My choice',#0,0,0,TRUE);
  48.     AddChoice('My second choice',#0,0,0,TRUE);
  49.     AddChoice('_',#0,0,0,TRUE);
  50.     AddChoice('My third choice',#0,0,0,TRUE);
  51.     AddTitle('My second menu');
  52.     AddChoice('Take command','T',0,0,TRUE);
  53.     AddChoice('A submenu!',#0,0,0,TRUE);
  54.     AddChoice('Submenu hamburger','H',0,0,FALSE);
  55.     AddChoice('Submenu noodles','N',0,0,FALSE);
  56.     if not MakeMenu(win) then
  57.         exit;
  58.     {--- Wait for the user to click on the close gadget or menu choice ---}
  59.     done := FALSE;
  60.     msg := nil;
  61.     repeat
  62.         { Wait returns a value, but we'll ignore it }
  63.         if Wait(1 shl win^.UserPort^.mp_SigBit)=0 then;
  64.         msg := pIntuiMessage(GetMsg(win^.UserPort));
  65.         if msg<>nil then
  66.         begin
  67.             with msg^ do
  68.             case Class of
  69.                 IDCMP_MENUPICK :
  70.                     begin
  71.                         menuno := (Code and MENUNUM) shr MENUSHIFT;
  72.                         itemno := (Code and ITEMNUM) shr ITEMSHIFT;
  73.                         subno := (Code and SUBNUM) shr SUBSHIFT;
  74.                         writeln('Picked MENU ',menuno,' ITEM ',itemno,
  75.                             ' SUBITEM ',subno)
  76.                     end;
  77.                 IDCMP_CLOSEWINDOW :
  78.                     done := TRUE
  79.             end;
  80.             ReplyMsg(pMessage(msg))
  81.         end
  82.     until done
  83. end.